home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 001_100 / DISK0070 / DISK0070.ZIP / DISKCAT.BAS < prev    next >
BASIC Source File  |  1983-07-27  |  21KB  |  523 lines

  1. 1 ''DISKCAT.BAS     (C) COPYRIGHT  1983  NELSON FORD   ALL RIGHTS RESERVED
  2. 2 ''To compile, the following lines must be changed:
  3. 3 ''     Uncompiled:             Compiled:
  4. 4 ''  54 SIDE1!=&HE000    to   54 SIDE1%=&HE000
  5. 5 ''  82 SIDE2!=&HE050    to   82 SIDE2%=&HE050
  6. 6 ''1710 CALL SIDE1! (B)  to   1710 CALL ABSOLUTE (B,SIDE1%)
  7. 7 ''1711 IF PEEK(&HE100)=&HFF THEN B=B+256: CALL SIDE2! (B): S2=1536 ELSE S2=0   to 1711 IF PEEK(&HE100)=&HFF THEN B=B+256: CALL ABSOLUTE (B,SIDE2%): S2=1536            ELSE S2=0
  8. 8 ''           (tunes in lines 800-900 are timed for compiled pgm.)
  9. 9 ''
  10. 10 CLEAR ,35000!,2000
  11. 11 DEFINT A-Z
  12. 12 KEY OFF: SCREEN 0     'check for CG Board and set foreground color:
  13. 13 BG=0:             IF (PEEK(&H410) AND &H30)<>&H30 THEN FG=6 ELSE FG=7
  14. 14 COLOR FG, BG, BG
  15. 15 SP$= SPACE$(30):  ESC$=CHR$(27):  YES=NOT NO:  NO= NOT YES
  16. 16 FILL$= STRING$(72,"z")+CHR$(13)+CHR$(10)
  17. 17 ENTR$= " "+CHR$(17)+STRING$(2,196)+CHR$(217)+" ":   DRV$=""
  18. 18 DEF SEG: POKE 106,0
  19. 19 RANDOMIZE(VAL(RIGHT$(TIME$,2))): IF FIX(RND*10)=3 THEN GOSUB 10000
  20. 20 WIDTH 80:  CLS:  LOCATE 1,1,0
  21. 21 'routine to read side 1 directory into high mem.
  22. 22 DATA &h55,  &h06
  23. 23 DATA &hb8,&h00,&h00
  24. 25 DATA &h8e,&hc0
  25. 26 DATA &h8b,&hec
  26. 28 DATA &hb4,&h02
  27. 30 DATA &hb0,&h07
  28. 32 DATA &hbb,&h00,&he1
  29. 34 DATA &hb9,&h02,&h00
  30. 38 DATA &h8b,&h76,&h08
  31. 40 DATA &h8b,&h14
  32. 42 DATA &hcd,&h13
  33. 44 DATA &h07,  &h5d
  34. 45 DATA &hca,&h02,&h00
  35. 50 DEF SEG=0
  36. 52 FOR I=0 TO 30:READ J:POKE &HE000+I,J:NEXT
  37. 54 SIDE1!=&HE000
  38. 55 '
  39. 60 'read side 2 directory
  40. 61 DATA &h55,  &h06
  41. 62 DATA &hb8,&h00,&h00
  42. 63 DATA &h8e,&hc0
  43. 64 DATA &h8b,&hec
  44. 65 DATA &hb4,&h02
  45. 67 DATA &hb0,&h02
  46. 68 DATA &hbb,&h00,&hef
  47. 69 DATA &hb9,&h01,&h00
  48. 71 DATA &h8b,&h76,&h08
  49. 72 DATA &h8b,&h14
  50. 73 DATA &hcd,&h13
  51. 74 DATA &h07,  &h5d
  52. 75 DATA &hca,&h02,&H0
  53. 80 FOR I=0 TO 30:READ J:POKE &HE050+I,J:NEXT
  54. 82 SIDE2!=&HE050
  55. 99 '
  56. 100 DIM TYPES$(16):  LAST.TYPE= 16
  57. 110 DIM NA$(112), DT$(112), SZ$(112), TY$(112), DS$(112), DISK$(500)
  58. 140 ON ERROR GOTO 142:  GOTO 160
  59. 142 GOSUB 10000:  CLS
  60. 143 LOCATE 12,10: PRINT"Drive containing DISKCAT.DTA or N for new catalog:  ";
  61. 144 FL=-1:  GOSUB 270
  62. 145 IF IN$="N" THEN JUST.STARTING=YES: CLS: LOCATE 12,20: PRINT "Drive for DISKCAT.DTA:  ";: FL=-1: GOSUB 270: DRV$=IN$+":": RESUME 165
  63. 146 DRV$= IN$+":"
  64. 150 RESUME 160
  65. 155 '
  66. 160 OPEN DRV$+"diskcat.nfo" FOR INPUT AS 1:  ON ERROR GOTO 0
  67. 161 CLS:  LOCATE 10,30: PRINT "loading DISKCAT.NFO"
  68. 162 INPUT #1, NUM.DISKS, NUM.FILES
  69. 163 FOR I=1 TO NUM.DISKS:  INPUT #1, DISK$(I): NEXT:  CLOSE
  70. 165 ON ERROR GOTO 0:  CLOSE
  71. 170 FOR I=1 TO LAST.TYPE:  READ TYPES$(I):  NEXT    'change to taste:
  72. 180 DATA "Accounting"
  73. 181 DATA "Communica."
  74. 182 DATA "Data Base "
  75. 183 DATA "Demo      "
  76. 184 DATA "Finance   "
  77. 185 DATA "Games     "
  78. 186 DATA "Graphics  "
  79. 187 DATA "Informatn."
  80. 190 DATA "Music     "
  81. 191 DATA "Statistics"
  82. 192 DATA "Util-BASIC"
  83. 193 DATA "Util-DOS  "
  84. 194 DATA "Ut-Printer"
  85. 195 DATA "Util-Other"
  86. 196 DATA "Word Proc."
  87. 197 DATA "Other     "
  88. 210 GOTO 500
  89. 250 '
  90. 260 '''''''''''''''''''''inkey routine''''''''''''''''''
  91. 265 '
  92. 270 IN$="": W$=INKEY$: WD=0: WS=0: WL=0: SOUND 80,.03: MOVE.IT=NO
  93. 280 QX= POS(0):  QY=CSRLIN
  94. 290 QL=ABS(FL):  IF QL=1 THEN QP$="?" ELSE QP$=" "
  95. 300 COLOR BG,FG
  96. 310 PRINT STRING$(QL,QP$);: LOCATE QY,QX
  97. 320 IF PROMPT$<>"" THEN PRINT LEFT$(PROMPT$,QL);: PROMPT$=""
  98. 330 LOCATE QY,QX
  99. 340 COLOR BG,FG
  100. 350 W$=INKEY$: IF W$="" THEN 350
  101. 355 IF LEN(W$)=2 THEN MOVE.IT=YES: KY=ASC(RIGHT$(W$,1)): COLOR FG,BG: RETURN
  102. 360 IF W$=ESC$ THEN COLOR FG,BG:  GOTO 500
  103. 370 IF WL=0 THEN IF W$="-" OR W$="+" THEN IN$=W$: COLOR FG,BG: RETURN
  104. 380 IF QL=WL THEN 410
  105. 390 IF FL>0 AND W$>=" " AND W$<="z" THEN 450
  106. 400 IF FL<0 THEN IF W$>="a" AND W$<="z" THEN W$=CHR$(ASC(W$)-32):  GOTO 450         ELSE IF W$>=" " AND W$<"a" THEN 450
  107. 410 IF W$=CHR$(13) THEN GOTO 440
  108. 420 IF WL>0 AND W$=CHR$(8) THEN PRINT CHR$(29) " " CHR$(29);:  WL= WL-1:            IN$=LEFT$(IN$,WL)
  109. 430 GOTO 350
  110. 440 COLOR FG,BG: LOCATE QY,QX: PRINT IN$;SPC(QL-WL);: RETURN
  111. 450 IF WL=0 AND QL>1 THEN COLOR BG,FG: PRINT STRING$(QL," ");: LOCATE QY,QX
  112. 460 COLOR FG,BG: PRINT W$;: IN$=IN$+W$: WL=WL+1
  113. 470 IF QL=1 THEN 440 ELSE 340
  114. 471 '
  115. 475 LOCATE 25,29: PRINT "press"ENTR$"to continue";: FL=0: GOSUB 270
  116. 476 RETURN
  117. 480 '
  118. 500 '''''''''''''''''''''main menu''''''''''''''''''''''
  119. 505 CLS:  CLOSE
  120. 507 LOCATE 22,15
  121. 509 PRINT "Press  Esc  at any prompt to return to this menu.";
  122. 510 LOCATE 3,25:  PRINT"DISKCAT - DISK FILE CATALOG":  LOCATE 6,1
  123. 520 PRINT TAB(21) "1  Read a disk directory into the catalog"
  124. 530 PRINT TAB(21) "2  Add descriptions to file names"
  125. 540 PRINT TAB(21) "3  Give a disk its own catalog."
  126. 550 PRINT TAB(21) "4  Find all copies of one file."
  127. 560 PRINT TAB(21) "5  Display all files for a disk name."
  128. 570 PRINT TAB(21) "6  Display all disk names."
  129. 580 PRINT TAB(21) "7  Print a hardcopy catalog listing."
  130. 590 PRINT TAB(21) "8  Purge deleted files from catalog."
  131. 601 PRINT TAB(21) "9  End"
  132. 610 PRINT:PRINT
  133. 620 PRINT TAB(21) "    Select an option.";
  134. 630 LOCATE,21:  FL=-1:  GOSUB 270:  IF IN$="P" THEN 700
  135. 635 IF IN$="S" THEN 8000
  136. 640 ON VAL(IN$) GOTO 1000,3000,2000,4000,5000,6000,670,700,800:  GOTO 630
  137. 660 '
  138. 670 LOCATE 20,20: PRINT "Which drive is DC-SORT on?  ";
  139. 680 FL=1:  GOSUB 270:  CHAIN IN$+":dc-sort"
  140. 690 '
  141. 700 'purge deleted files:
  142. 701 '
  143. 705 GOSUB 1320   'open diskcat.dta
  144. 710 CLS: LOCATE 12,30:  PRINT "purging"
  145. 715 I=1:  J=1:  NM$="zzzzzzzz"
  146. 720 GET 1,I
  147. 725 IF A2$<>NM$ THEN PUT 1,J:  J=J+1  ELSE NUM.FILES= NUM.FILES -1
  148. 730 IF LEFT$(ALL$,1)="\" THEN  CLOSE:  GOTO 500
  149. 735 I=I+1
  150. 740 GOTO 720
  151. 790 '
  152. 800 'exit to DOS:
  153. 801 '
  154. 810 CLS: LOCATE 10,20
  155. 812 X=INT(RND*5):  ON X GOTO 820,825,830,835,899
  156. 820 PRINT "Turn out the lights, the party's over..."
  157. 821 SOUND 311,2: GOSUB 862: SOUND 311,2: GOSUB 862: SOUND 392,2: GOSUB 862:         SOUND 467,6: GOSUB 863: SOUND 392,2: GOSUB 862: SOUND 349,2: GOSUB 862:         SOUND 392,2: GOSUB 862: SOUND 349,2: GOSUB 862: SOUND 311,6:  GOTO 850
  158. 825 PRINT "Miller time..."
  159. 826 SOUND 392,2: GOSUB 862: SOUND 392,6: GOSUB 863: SOUND 392,2: GOSUB 862:         SOUND 349,2: GOSUB 862: SOUND 392,2: GOSUB 862: SOUND 424,6: GOTO 850
  160. 830 SOUND 2000,3: SOUND 1000,3: SOUND 1350,5
  161. 831 PRINT "Now, where did I put that Pac Man disk?": GOTO 850
  162. 835 SOUND 424,4: GOSUB 862: SOUND 311,2: GOSUB 860: SOUND 311,2: GOSUB 862:         SOUND 349,4: GOSUB 862: SOUND 311,6: GOSUB 861: PRINT "          THAT'S        ";: SOUND 392,5: GOSUB 862: SOUND 424,8: PRINT"ALL": GOTO 850
  163. 850 GOSUB 865: END
  164. 860 FOR I!=1 TO 300:  NEXT:  RETURN
  165. 861 FOR I!=1 TO 800:  NEXT:  RETURN
  166. 862 FOR I!=1 TO 400:  NEXT:  RETURN
  167. 863 FOR I!=1 TO 1000: NEXT:  RETURN
  168. 865 FOR I!=1 TO 2000: NEXT:  RETURN
  169. 899 GOTO 812
  170. 990 '
  171. 992 '''''''''''''''''''''add to catalog
  172. 994 '
  173. 1000 GOSUB 1080   'get disk name for files being added or quit
  174. 1010   IF QUIT THEN 500
  175. 1020 GOSUB 1600   'go read target disk
  176. 1025 GOSUB 1910   'sort disk filenames
  177. 1030 GOSUB 1320   'open DISKCAT.DTA file
  178. 1040 GOSUB 1440   'save last disk read
  179. 1050 GOTO 1000
  180. 1070 '
  181. 1080 CLS: LOCATE 11,30: PRINT "(Press" ENTR$ "to quit.)":  QUIT=NO
  182. 1090 LOCATE 10,20: PRINT "Name or Number of disk being read: ";
  183. 1100 FL= -8:  GOSUB 270:  NM$=LEFT$(IN$+SPACE$(8),8)
  184. 1110 IF IN$="" THEN QUIT = YES:  RETURN   ELSE I=1
  185. 1120 IF NUM.DISKS=0 THEN NUM.DISKS=1:  DISK$(1)= NM$:  RETURN
  186. 1130 IF DISK$(I)<>NM$ THEN I=I+1:  IF I <=NUM.DISKS THEN 1130                        ELSE NUM.DISKS=NUM.DISKS+1: DISK$(I)=LEFT$(NM$+SPACE$(8),8): RETURN
  187. 1140 CLS: LOCATE 10,30: PRINT "Name already used.":  LOCATE 12,1
  188. 1150 PRINT TAB(15) "1  Delete entries in DISKCAT.DTA for "NM$
  189. 1151 PRINT TAB(15) "2  Update the listing in DISKCAT.DTA for "NM$
  190. 1152 PRINT TAB(15) "3  Enter another disk name": PRINT: PRINT TAB(15) "";
  191. 1160 FL=1:  GOSUB 270:  X=VAL(IN$)
  192. 1165 IF X=2 THEN UPDATE=YES:  RETURN  ELSE UPDATE=NO
  193. 1170 IF X=3 THEN CLS:  GOTO 1080  ELSE IF X<>1 THEN 1140
  194. 1180 PRINT:  PRINT "Verify - "
  195. 1190 PRINT "Delete files already in the catalog with the disk name of "NM$;
  196. 1200 PRINT " (Y/N) ";:  FL= -1:  GOSUB 270:  IF IN$<>"Y" THEN 1080
  197. 1210 '
  198. 1220 CLS: LOCATE 12,30:  PRINT "deleting":  LOCATE 14,17
  199. 1221 PRINT "(Files are only being marked as deleted.":  LOCATE,5
  200. 1222 PRINT "Select Purge at the menu to clean deleted files out of catalog.)"
  201. 1230 FOR J= I TO NUM.DISKS:  DISK$(J)= DISK$(J+1): PRINT ".";:  NEXT:
  202. 1240 NUM.DISKS= NUM.DISKS -1
  203. 1250 GOSUB 1320    'open the DISKCAT.DTA file
  204. 1260 GET 1,I
  205. 1270 IF LEFT$(ALL$,1)="\" THEN  CLOSE:  GOTO 1080
  206. 1275 IF A2$= NM$ THEN LSET ALL$=FILL$:  PUT 1,I
  207. 1280 I=I+1
  208. 1290 GOTO 1260
  209. 1310 '
  210. 1320 ON ERROR GOTO 1330:  GOTO 1380
  211. 1330 CLS:  LOCATE 12,15
  212. 1340 PRINT "Press"ENTR$"when disk with DISKCAT.DTA is in drive "DRV$
  213. 1350 FL=0:  GOSUB 270
  214. 1360 IF JUST.STARTING THEN JUST.STARTING= NO: RESUME 1390 ELSE RESUME 1380
  215. 1370 '
  216. 1380 OPEN DRV$+"diskcat.dta" FOR INPUT AS #1:  CLOSE
  217. 1390 OPEN DRV$+"diskcat.dta" AS 1 LEN=74:  ON ERROR GOTO 0
  218. 1400 FIELD 1, 12 AS A1$, 8 AS A2$, 10 AS A3$, 25 AS A4$, 10 AS A5$, 7 AS A6$,        2 AS A7$:  LSET A7$=CHR$(13)+CHR$(10)
  219. 1410 'na:12  dsk:8  type:10  descr:25  dt:10  size:7
  220. 1420 FIELD 1, 74 AS ALL$
  221. 1430 RETURN
  222. 1440 LSET A2$= NM$: LSET A3$= SPACE$(10):  LSET A4$= SPACE$(25)
  223. 1444 IF UPDATE THEN 9000
  224. 1445 CLS: LOCATE 1,30: PRINT "Adding to catalog"
  225. 1450   FOR I=1 TO LAST.FILE
  226. 1460 LSET A1$= NA$(I)
  227. 1470 LSET A5$= DT$(I)
  228. 1480 LSET A6$= SZ$(I)
  229. 1485 PRINT A2$"  "A1$"  "A5$"  "A6$
  230. 1490 PUT 1, NUM.FILES +I
  231. 1500   NEXT
  232. 1510 NUM.FILES= NUM.FILES +LAST.FILE
  233. 1520 LAST.FILE= 0
  234. 1530 '
  235. 1540 LSET ALL$="\":  PUT 1:  CLOSE
  236. 1550 ON ERROR GOTO 1330
  237. 1560 OPEN DRV$+"diskcat.nfo" FOR OUTPUT AS 1:  ON ERROR GOTO 0
  238. 1570 WRITE #1, NUM.DISKS:  WRITE #1, NUM.FILES
  239. 1580 FOR I=1 TO NUM.DISKS:  WRITE #1, DISK$(I):  NEXT:  CLOSE
  240. 1590 RETURN
  241. 1600 '
  242. 1610 CLS:  LOCATE 11,20
  243. 1620 PRINT "(Press Esc to Quit)":  LOCATE 10,10
  244. 1630 PRINT "Which floppy (Left or Rt.) has the disk to be read?  ";
  245. 1640 FL= -1:  GOSUB 270
  246. 1660 IF IN$="L" THEN IN$="A" ELSE IF IN$="R" THEN IN$="B" ELSE 1640
  247. 1670 DRV.2$= IN$
  248. 1680 '
  249. 1690 CLS:IF DRV.2$="A" THEN B=0 ELSE B=1
  250. 1700 DEF SEG=0
  251. 1710 CALL SIDE1! (B)  'read directory into high mem. (up to 64 files)
  252. 1711 IF PEEK(&HE100)=&HFF THEN B=B+256: CALL SIDE2! (B): S2=1536  ELSE S2=0
  253. 1720 CLS:  F=1:  BUF= &HE100+1024
  254. 1730 '
  255. 1740     FOR I=0 TO 2016+S2 STEP 32
  256. 1750 F$="":  IF PEEK(I+BUF)=&HE5 THEN 1880  'skip deleted files
  257. 1755 IF PEEK(I+BUF)=32 THEN I=2016+S2: GOTO 1880
  258. 1760 FOR J=0 TO 7:  F$= F$ +CHR$(PEEK(J+I+BUF)):  NEXT:  F$= F$ +"."
  259. 1770 FOR J=8 TO 10: F$= F$ +CHR$(PEEK(J+I+BUF)):  NEXT
  260. 1780 MO$ = STR$((PEEK(I+BUF+&H19) AND 1)*8 + ((PEEK(I+BUF+&H18) AND 224)/32))
  261. 1790 IF LEN(MO$)>2 THEN MO$=RIGHT$(MO$,2)
  262. 1800 DAY$ = STR$(PEEK(I+BUF+&H18) AND 31)
  263. 1810 IF LEN(DAY$)>2 THEN DAY$=RIGHT$(DAY$,2)
  264. 1820 YR$ = RIGHT$(STR$((INT(PEEK(I+BUF+&H19)/2))+1980),4)
  265. 1830 D8$=MO$+"/"+DAY$+"/"+YR$
  266. 1840 SIZE!=PEEK(I+BUF+&H1C)+(PEEK(I+BUF+&H1D)*256)+(PEEK(I+BUF+&H1E)*65536!)
  267. 1845 IF SIZE! > 360000! THEN I=2016+S2:  GOTO 1880
  268. 1846 IF SIZE!<0 THEN SIZE!= 65536! +SIZE!
  269. 1850 LOCATE ,15:  PRINT F$; "    ";
  270. 1860 PRINT "  " D8$ " " SIZE!
  271. 1870 NA$(F)=F$:  DT$(F)= D8$:  SZ$(F)= STR$(SIZE!):  F=F+1
  272. 1880     NEXT
  273. 1890 LAST.FILE= F -1
  274. 1900 RETURN
  275. 1901 '
  276. 1905 '''''''''''''sort filenames:
  277. 1906 '
  278. 1910 CLS:  LOCATE 12,30:  PRINT"Sorting file names"
  279. 1915 M=LAST.FILE:  N=M:  C=0
  280. 1920 M=INT(M/2):IF M=0 THEN  RETURN  ELSE J=1: K=N-M
  281. 1925 I=J
  282. 1930 L=I+M:  C=C+1
  283. 1935 IF NA$(I) < NA$(L) THEN 1950
  284. 1937 SWAP DT$(I),DT$(L):  SWAP SZ$(I),SZ$(L)
  285. 1940 SWAP NA$(I),NA$(L):  I=I-M:  IF I=>1 THEN 1930
  286. 1945 I=I-M:  IF I=>1 THEN 1930
  287. 1950 J=J+1:  IF J>K THEN 1920 ELSE 1925
  288. 1990 '
  289. 2000 ''''''''''''''give disk its own catalog:
  290. 2001 '
  291. 2010 GOSUB 2420  'get disk name
  292. 2020 GOSUB 1310  'open DISKCAT.DTA file
  293. 2030 GOSUB 2320  'get files for the disk
  294. 2040 GOSUB 2080  'create directory file
  295. 2050 GOTO 500
  296. 2060 '
  297. 2080 CLS: LOCATE 10,10
  298. 2090 PRINT "Place "DSK$" disk in drive and enter drive spec. (A-H): ";
  299. 2100 FL=-1:  GOSUB 270: IF IN$<"A" OR IN$>"H" THEN 2080
  300. 2110 CLS: LOCATE 10,30: PRINT"Saving as DIR-LIST"
  301. 2120 OPEN IN$+":DIR-LIST" AS 1 LEN=56
  302. 2130 FIELD 1, 16 AS NM$, 13 AS TYP$, 25 AS DES$, 2 AS CR$
  303. 2135 FIELD 1, 54 AS A$, 2 AS Y$
  304. 2140 I=1:  LSET CR$=CHR$(13)+CHR$(10)
  305. 2145 LSET A$="FILE NAME       FILE TYPE           DESCRIPTION":  PUT 1
  306. 2146 LSET A$="-------------   ----------   -------------------------":  PUT 1
  307. 2150 FOR I=1 TO LAST.IN.DIR
  308. 2160   LSET NM$=NA$(I):  LSET TYP$=TY$(I):  LSET DES$=DS$(I)
  309. 2170   PUT 1
  310. 2180 NEXT:  CLOSE
  311. 2190 RETURN
  312. 2200 '
  313. 2300 '''''''''''''read all files in for one disk:
  314. 2310 '
  315. 2320 I=1:  GOSUB 2375
  316. 2330 FOR J=1 TO NUM.FILES
  317. 2340   GET 1,J:  IF A2$<>DSK$ THEN 2360
  318. 2350   NA$(I)=A1$:  TY$(I)=A3$:  DS$(I)=A4$:  I=I+1
  319. 2355   PRINT  A1$ "  " A3$ "  " A4$ "  " A5$ "  " A6$
  320. 2356   IF I MOD 20=0 AND J<NUM.FILES THEN GOSUB 475: GOSUB 2375
  321. 2360 NEXT:  CLOSE:  LAST.IN.DIR= I-1
  322. 2370 RETURN
  323. 2375 CLS:  PRINT TAB(30) "Contents of "DSK$:  PRINT:  RETURN
  324. 2380 '
  325. 2400 ''''''''''''''get name of disk in catalog:
  326. 2410 '
  327. 2420 CLS: LOCATE 12,15
  328. 2425 PRINT "Enter name or press  + or -  to scroll disk names."
  329. 2430 PRINT TAB(29) "(Press Esc to cancel.)"
  330. 2440 LOCATE 10,30:  PRINT "Disk name:  ";:  I=1
  331. 2450 PROMPT$= DISK$(I):  FL=-8:  GOSUB 270
  332. 2460 IF IN$="+" THEN IF I<NUM.DISKS THEN I=I+1: GOTO 2450 ELSE I=1: GOTO 2450
  333. 2470 IF IN$="-" THEN IF I>1 THEN I=I-1: GOTO 2450 ELSE I=NUM.DISKS: GOTO 2450
  334. 2480 IF IN$="" THEN 2500  ELSE DSK$= IN$:  I=1
  335. 2490 IF DISK$(I) <> DSK$  THEN  IF I<NUM.DISKS THEN I=I+1:  GOTO 2490                  ELSE LOCATE 15,30:  PRINT "NO MATCH.":  LOCATE 10,42:  GOTO 2450
  336. 2500 DSK$= LEFT$(DISK$(I)+SPACE$(8),8)
  337. 2510 RETURN
  338. 3000 '
  339. 3010 '''''''''''''''''''''''add descriptions
  340. 3020 '
  341. 3030 CLS: PRINT"FILE TYPES:"
  342. 3040 FOR I=1 TO 4:  FOR J= I TO 16 STEP 4
  343. 3050   PRINT USING "   ##  &"; J; TYPES$(J);
  344. 3060 NEXT:  PRINT:  NEXT:  LOCATE 10,1
  345. 3070 PRINT"    Name           Disk           Type              Description"
  346. 3080 PRINT"------------     --------      ----------   -------------------------":   LOCATE 14,1
  347. 3085 PRINT"============     ========      ==========   =========================":   LOCATE 8,2
  348. 3090 PRINT"(Enter one of the above #'s for file type or input a new type.)":         LOCATE 18,9: PRINT "Hold  [Alt]  and press key indicated for:":PRINT
  349. 3100 PRINT"[P] Prior entry.  [F] Find file.  [D] Find disk.  [K] Kill entry.  [Q] Quit."
  350. 3110 OPEN DRV$+"diskcat.dta" AS 1 LEN=74:  I=1
  351. 3120 FIELD 1, 12 AS A1$, 8 AS A2$, 10 AS A3$, 25 AS A4$, 10 AS A5$, 7 AS A6$,                 2 AS A7$:  FIELD 1, 74 AS ALL$:  FIELD 1, 1 AS T$
  352. 3130 LOCATE 13,1
  353. 3140 GET 1,I: LOCATE,1: IF LEFT$(A1$,1)="\" THEN 3270 ELSE PRINT TAB(79);
  354. 3141 IF T$ <> "z" THEN 3150
  355. 3142 IF KY<>25 OR I=1 THEN I=I+1 ELSE I=I-1
  356. 3143 KY=0:  GOTO 3140
  357. 3150 COLOR FG,BG:  LOCATE,1: PRINT A1$ TAB(18) A2$;:  TY$=A3$:  DS$=A4$
  358. 3160 LOCATE,32:  FL=10:  PROMPT$=A3$:  GOSUB 270:  T= VAL(IN$)
  359. 3161 IF NOT MOVE.IT THEN 3170
  360. 3165  IF KY=16 THEN 500 ELSE IF KY=25 THEN I=I+(I>1) ELSE IF KY=32 THEN GOSUB         3510 ELSE IF KY=33 THEN GOSUB 3350 ELSE IF KY=37 THEN GOTO 3700 ELSE 3150
  361. 3166  GOTO 3140
  362. 3170 IF LEN(IN$)<3 THEN IF T>0 AND T<=LAST.TYPE  THEN IN$=TYPES$(T)
  363. 3180 IF IN$<>"" THEN TY$= IN$
  364. 3190 LOCATE,32:  PRINT TY$;:  LSET A3$= TY$
  365. 3200 LOCATE,45:  FL=25:  PROMPT$=A4$:  GOSUB 270
  366. 3205 IF MOVE.IT THEN LOCATE,45: PRINT A4$;:  GOTO 3150
  367. 3210 IF IN$<>"" THEN LSET A4$= IN$: LOCATE,45: PRINT A4$;
  368. 3230 PUT 1,I:  I=I+1
  369. 3240 LOCATE,1: COLOR,FG: PRINT TAB(70);: COLOR,BG
  370. 3250 GOTO 3140
  371. 3252 '
  372. 3255 '''''''end routine:
  373. 3270 GOTO 500
  374. 3320 '
  375. 3330 ''''''''''find a file:
  376. 3340 '
  377. 3350 LOCATE 25,15
  378. 3360 PRINT "Enter all or part of file name:  ";:  F=1
  379. 3370 FL=-12:  GOSUB 270:  X$=IN$
  380. 3380 GET 1,F
  381. 3390 IF LEFT$(A1$,1)= "\" THEN 3460
  382. 3400 IF INSTR(A1$,X$) =0 THEN F=F+1:  GOTO 3380
  383. 3401 LOCATE,5:  COLOR BG,FG:  PRINT A1$;:  COLOR FG,BG
  384. 3405 PRINT " is on the disk named ";:  COLOR BG,FG
  385. 3410 PRINT A2$;:  COLOR FG,BG
  386. 3412 X=INT(RND*7):  ON X GOSUB 3481,3482,3483,3484,3485,3486,3487
  387. 3413 PRINT "  " I$ "?  (Y/N) ";
  388. 3420 FL=-1:  GOSUB 270
  389. 3430 IF IN$<>"Y" THEN F=F+1:  GOTO 3380
  390. 3440 I=F:  LOCATE,5: COLOR FG,BG: PRINT SPC(70);: LOCATE 13,1: RETURN
  391. 3460 LOCATE,5:  PRINT SPC(20) "No match.  Press"ENTR$ SPACE$(33);
  392. 3470 FL=0:  GOSUB 270: LOCATE 25,15: PRINT SPACE$(60);:  LOCATE 13,1
  393. 3480 RETURN
  394. 3481 I$="     Is this it":  RETURN
  395. 3482 I$="       This one":  RETURN
  396. 3483 I$="   How about it":  RETURN
  397. 3484 I$="This must be it":  RETURN
  398. 3485 I$="   Close enough":  RETURN
  399. 3486 I$=" Can I stop now":  RETURN
  400. 3487 I$="     Is this it":  RETURN
  401. 3490 '
  402. 3500 ''''''''''''''''''''find a disk:
  403. 3510 LOCATE 25,15
  404. 3520 PRINT "Enter all or part of disk name:  ";:  F=1
  405. 3530 FL=-8:  GOSUB 270:  X$=IN$: IF X$="" OR X$=CHR$(27) THEN RETURN
  406. 3540 GET 1,F
  407. 3550 IF LEFT$(A1$,1)= "\" THEN 3620
  408. 3560 IF INSTR(A2$,X$) =0 THEN 3610
  409. 3570 LOCATE,15:  PRINT A2$ "     Is this it? (Y/N) ";
  410. 3580 FL=1:  GOSUB 270
  411. 3590 IF IN$<>"y" AND IN$<>"Y" THEN 3610
  412. 3600 I=F:  LOCATE,15: COLOR FG,BG: PRINT SPC(50);: LOCATE 13,1: RETURN
  413. 3610 F= F+1:  GOTO 3540
  414. 3620 LOCATE,15:  PRINT SPC(10) "No match.  Press Enter." SPC(20);
  415. 3630 FL=0:  GOSUB 270: LOCATE,15: PRINT SPC(60);:  LOCATE 13,1
  416. 3640 RETURN
  417. 3699 '
  418. 3700 ''''''''''''delete an entry
  419. 3701 '
  420. 3710 LSET ALL$= FILL$:  PUT 1,I: I=I+1:  GOTO 3140
  421. 3999 '
  422. 4000 '''''''''''''find all copies of one file
  423. 4001 '
  424. 4010 GOSUB 1320   'open DISKCAT.DTA
  425. 4020 CLS: LOCATE 10,15
  426. 4030 GOSUB 3360   'input file name
  427. 4040 GOTO 500
  428. 4999 '
  429. 5000 '''''''''''''display all files for a disk name:
  430. 5001 '
  431. 5010 GOSUB 2420  'get disk name
  432. 5020 GOSUB 1310  'open DISKCAT.DTA file
  433. 5030 GOSUB 2320  'get files & display them
  434. 5040 GOSUB 475   'press Enter...
  435. 5050 GOTO 500
  436. 5999 '
  437. 6000 ''''''''''''''display all disk names:
  438. 6001 '
  439. 6010 CLS:  L=3: TB=2:  PRINT TAB(27) "Names of Disks in Catalog": PRINT
  440. 6020 FOR I=1 TO NUM.DISKS
  441. 6030   LOCATE L,TB: PRINT DISK$(I);:  L=L+1
  442. 6040   IF L=21 THEN L=3: IF TB<72 THEN TB=TB+10 ELSE GOSUB 475: CLS: TB=2
  443. 6050 NEXT
  444. 6060 GOSUB 475
  445. 6070 GOTO 500
  446. 8000 '
  447. 8005 '''''''''''''sort disk names:
  448. 8006 '
  449. 8010 CLS:  LOCATE 12,30:  PRINT"Sorting disk names"
  450. 8015 M=NUM.DISKS:  N=M:  C=0
  451. 8020 M=INT(M/2):IF M=0 THEN  500  ELSE J=1: K=N-M
  452. 8025 I=J
  453. 8030 L=I+M:  C=C+1
  454. 8035 IF DISK$(I) < DISK$(L) THEN 8050
  455. 8040 SWAP DISK$(I),DISK$(L):  I=I-M:  IF I=>1 THEN 8030
  456. 8045 I=I-M:  IF I=>1 THEN 8030
  457. 8050 J=J+1:  IF J>K THEN 8020 ELSE 8025
  458. 9000 'update files   (branches here from 1444)
  459. 9005 CLS:  START=1
  460. 9010   FOR I=1 TO NUM.FILES
  461. 9012 J= START
  462. 9020 GET 1,I:  IF A2$ <> NM$ THEN 9110
  463. 9030 IF A1$ = NA$(J) THEN LSET A5$= DT$(J):  LSET A6$= SZ$(J):  PUT 1,I:             START= START -(J=START+1): NA$(J)= SPACE$(12): GOTO 9110
  464. 9040 IF A1$ < NA$(J) THEN 9070
  465. 9060 IF J < LAST.FILE THEN J=J+1:  GOTO 9030
  466. 9070 LSET ALL$= FILL$:  PUT 1,I
  467. 9110   NEXT
  468. 9120 LSET A2$= NM$:  LSET A3$= SPACE$(10):  LSET A4$= SPACE$(25)
  469. 9200   FOR I=1 TO LAST.FILE
  470. 9210 IF NA$(I)= SPACE$(12) THEN 9250
  471. 9220 LAST.FILE= LAST.FILE +1
  472. 9230 LSET A1$= NA$(I):  LSET A5$= DT$(I):  LSET A6$= SZ$(I)
  473. 9240 PUT 1,LAST.FILE
  474. 9250   NEXT
  475. 9260 CLOSE:  RETURN
  476. 9999 '''
  477. 10000 IF ALREADY.DID.THIS THEN RETURN ELSE ALREADY.DID.THIS = YES
  478. 10005 WIDTH 40: CLS:  LOCATE 10,16,0
  479. 10010 PRINT "DISKCAT";:  I$="CAT"
  480. 10020 X=VAL(RIGHT$(TIME$,1)): WHILE ABS(VAL(RIGHT$(TIME$,1))-X)<2:WEND
  481. 10030 LOCATE 10,20: PRINT " ";: LOCATE 12,16: PRINT "C";: SOUND 311,1
  482. 10040 GOSUB 10360
  483. 10050 LOCATE 10,21: PRINT " ";: LOCATE 12,17: PRINT "A";: SOUND 392,1
  484. 10060 GOSUB 10360
  485. 10070 LOCATE 10,22: PRINT " ";: LOCATE 12,18: PRINT "T";: SOUND 467,1
  486. 10080 X=VAL(RIGHT$(TIME$,1)): WHILE ABS(VAL(RIGHT$(TIME$,1))-X)<2:WEND
  487. 10090 PRINT "A";: SOUND 467,1: GOSUB 10370
  488. 10100 PRINT "L";: SOUND 424,1: GOSUB 10370
  489. 10110 PRINT "O";: SOUND 392,1: GOSUB 10370
  490. 10120 PRINT "G";: SOUND 349,1: GOSUB 10370
  491. 10130 LOCATE 14,16:  PRINT "PROGRAM":  SOUND 311,2
  492. 10140 LOCATE 18,5: PRINT "(C) Copyright  Nelson Ford  1983": PRINT
  493. 10150 PRINT TAB(12) "P.O. Box 61565"
  494. 10160 PRINT TAB(12) "Houston, Tx 77208"
  495. 10170 PRINT TAB(12) "Source:  ST3564"
  496. 10180 GOSUB 863
  497. 10190 LOCATE 10,20:PRINT " "CHR$(8)" ";:  SOUND 37,20
  498. 10200 LOCATE 24,8
  499. 10210 PRINT"press"ENTR$"to continue";
  500. 10220 FL=0:  GOSUB 250:  WIDTH 80:  CLS:  X=20
  501. 10225 LOCATE 6,30: PRINT "Freebie-Ware"
  502. 10230 LOCATE 8,X
  503. 10240 PRINT"If you find this program useful";
  504. 10241 T=VAL(RIGHT$(TIME$,1)): WHILE ABS(VAL(RIGHT$(TIME$,1))-T)<3:WEND
  505. 10250 PRINT TAB(X)"  bring money."
  506. 10251 PRINT TAB(X)"Lots of it."
  507. 10252 PRINT TAB(X)"In a brown paper bag."
  508. 10260 PRINT TAB(X)"No bills larger than a $20."
  509. 10270 PRINT TAB(X)"No consecutive serial numbers."
  510. 10280 PRINT TAB(X)"Drive to the park and leave the money on"
  511. 10290 PRINT TAB(X)"  the third park bench by the yellow can."
  512. 10300 PRINT TAB(X)"This is not a joke.  Someone will be watching"
  513. 10310 PRINT TAB(X)"  your house to see if you use this program."
  514. 10320 LOCATE 24,X
  515. 10330 PRINT"Press"ENTR$"when you've got the money ready.";
  516. 10340 FL=0:  GOSUB 250:  LOCATE ,,0
  517. 10350 RETURN
  518. 10360 FOR I!=1 TO 600: NEXT:  RETURN
  519. 10370 FOR I!=1 TO 300: NEXT:  RETURN
  520. 10340 FL=0:  GOSUB 250:  LOCATE ,,0
  521. 10350 RETURN
  522. 10360 FOR I!=1 TO 600: NEXT:  RETURN
  523. 10370 FOR I!=1 TO 300: NEXT:  RE